home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 003 / mailist1.arc / MAILIST1.BAS (.txt) next >
Encoding:
GW-BASIC  |  1984-10-27  |  29.8 KB  |  743 lines
  1. 10  '(C) Copyright M. Berry and W. Dwinell 1982, 1983
  2. 99  '------------------------------INITILIZE------------------------------------
  3. 100  'KEY OFF:FOR L=1 TO 10:KEY L,"":NEXT L
  4. 101  LOCATE ,,0:KEY OFF:GOSUB 20000:CR$=CHR$(13):ESC$=CHR$(27)
  5. 102  CLS:ON ERROR GOTO 10000
  6. 103  OF=1:IPC=8:PT=1:LOCATE 5,15:PRINT"Enter the File Name you wish to use:":LOCATE 5,52:GOSUB 15150:SWAP RAN$,IP$:IF RAN$=ESC$ THEN RAN$=""
  7. 104  IF LEN(RAN$)<>0 THEN GOTO 108 ELSE LOCATE 23,1:BEEP:PRINT"You did not enter a file name. Do you wish to exit program (Y/N)?":LOCATE 23,67:IPC=1:GOSUB 15150:IF IP$="y" THEN IP$="Y"
  8. 105  IF IP$="Y" THEN 7020 ELSE LOCATE 23,1:PRINT STRING$(68," "):GOTO 103
  9. 106  '
  10. 108  RAN$="B:"+RAN$
  11. 110  FOR L=1 TO 10:KEY L,"":NEXT
  12. 120  WIDTH 80
  13. 125  C$=SPACE$(15):S$=SPACE$(2):Z$=SPACE$(5):PH$=SPACE$(12):ST$=SPACE$(20):N1$=SPACE$(10):N2$=SPACE$(15)
  14. 127  COMMON N,RAN$,IN$,NBR$,S,CR$,ESC$
  15. 140  N=0:DIM I$(1000):DIM I1$(1000):DEFINT A-Z'         MAXIUM NBR OF RECORDS
  16. 160  ON ERROR GOTO 10000
  17. 280  IN$=RAN$+".IDX"
  18. 285  NBR$=RAN$+".CTR"
  19. 300  OPEN "i",#3,NBR$
  20. 360  INPUT #3,N
  21. 365  CLOSE 3
  22. 410  OPEN "R",#2,RAN$,79
  23. 420  FIELD 2, 15 AS CF$, 2 AS SF$, 5 AS ZF$, 12 AS PHF$, 20 AS STF$, 10 AS N1F$, 15 AS N2F$
  24. 500  ' ------------------------ MAIN MENU ROUTINE ------------------------------
  25. 520  CLS:I=0:MN=0:KEY 9,")":GOSUB 11300
  26. 540  LOCATE 5,22:COLOR 15,0:PRINT"THE FOLLOWING OPTIONS ARE AVAILABLE":COLOR 7,0
  27. 560  LOCATE 8,32:PRINT"1. Add to file"
  28. 580  LOCATE 9,32:PRINT"2. Sort file"
  29. 600  LOCATE 10,32:PRINT"3. Display file"
  30. 620  LOCATE 11,32:PRINT"4. Correct file"
  31. 640  LOCATE 12,32:PRINT"5. Print file"
  32. 660  LOCATE 13,32:PRINT"6. Delete record"
  33. 665  LOCATE 14,32:PRINT"7. Display last record number"
  34. 670  LOCATE 15,32:PRINT"8. Automatic phone dialer"
  35. 672  LOCATE 25,1:COLOR 15,0:PRINT"F9 ";:COLOR 0,7:PRINT" TO END PROGRAM ";:LOCATE 25,50:COLOR 15,0:PRINT"Esc ";:COLOR 0,7:PRINT" RETURN TO FILE SELECTION ";:COLOR 7,0
  36. 682  LOCATE ,,0:LOCATE 19,22:PRINT"Type the number of your choice:";:IPC=1:PT=0:OF=1:GOSUB 15150:SWAP IP$,I$:IF I$="" THEN 682 ELSE IF I$=")" THEN 7020 ELSE IF I$=ESC$ THEN CLOSE 2:ERASE I$:ERASE I1$:GOTO 102
  37. 683  IF VAL(I$)=0 THEN GOTO 700
  38. 684  I=VAL(I$)
  39. 685  IF I=7 THEN LOCATE 23,22:PRINT"THERE ARE";:COLOR 15,0:PRINT N;:COLOR 7,0:PRINT"RECORDS IN THIS FILE             ";:I=0:GOTO 682
  40. 700  IF I<1 OR I>8 THEN LOCATE 23,22:BEEP:COLOR 15,0:PRINT"PLEASE TYPE A NUMBER BETWEEN 1 AND 8":COLOR 7,0:GOTO 682
  41. 720  ON I GOTO 1010,2010,3020,4020,5020,6020,0,12010
  42. 1000  ' --------------------------ADD TO FILE ROUTINE --------------------------
  43. 1010  CLS:LOCATE 1,30:PRINT"RECORD NUMBER ";:GOSUB 11010
  44. 1020  F=0:IF N=0 THEN N=1 ELSE N=N+1
  45. 1040  LOCATE 1,43:PRINT N:GOSUB 11200
  46. 1060  MID$(N1$,1)=SPACE$(10)'  first name
  47. 1080  GOSUB 11400:GOTO 1840
  48. 1282  IF F=1 THEN 1840:' CHECK FOR ERROR CORR
  49. 1840  LOCATE 25,1:PRINT STRING$(26,32);:GOSUB 8020:IF C2=1 THEN C2=0:GOTO 520 ELSE LOCATE 23,1:PRINT STRING$(75,32);:LOCATE 23,1:PRINT"Is the information displayed correct? ";:IPC=1:PT=0:OF=1:GOSUB 15150:SWAP IP$,I$
  50. 1860  IF I$="Y" OR I$="y" THEN 1987
  51. 1880  IF I$="N" OR I$="n" THEN LOCATE 23,1:PRINT STRING$(40,32):GOSUB 11400:GOTO 1840
  52. 1900  BEEP:LOCATE 23,1:PRINT STRING$(70,32);:LOCATE 23,1:PRINT"You must answer yes or no. Please reenter";:FOR T = 1 TO 2000:NEXT T:GOTO 1840
  53. 1987  IF LEN(N2$)<15 THEN N2$=N2$+" ":GOTO 1987
  54. 1989  IF F1=2 GOTO 4242 ELSE IF F1=3 GOTO 4425 ELSE I$=Z$+N2$+STR$(N):GOSUB 10200
  55. 1990  OPEN IN$ FOR APPEND AS 1:PRINT#1,I$:CLOSE 1:OPEN "O",3,NBR$:PRINT#3,N:CLOSE 3
  56. 1991  LOCATE 23,1:PRINT"Record has been written to file. Do you want to input another ";:IPC=1:PT=0:OF=1:GOSUB 15150:SWAP IP$,I$:IF I$="Y" OR I$="y" THEN LOCATE 23,1:PRINT STRING$(70,32);:GOTO 1020
  57. 1993  IF I$="N" OR I$="n" THEN GOTO 520
  58. 1994  BEEP:LOCATE 23,1:PRINT STRING$(70,32);:LOCATE 23,1:PRINT"You must answer yes or no. Please reenter";:GOTO 1991
  59. 2000  ' ----------------------- SORT ROUTINE ---------------------------------
  60. 2010  CLOSE 2:COLOR 15,0:LOCATE 19,22:PRINT"Loading Sort program.............":CHAIN "A:MAILSORT.BAS"
  61. 3000  ' --------------------- DISPLAY FILE -------------------------
  62. 3020  MN=3:KEY 9,"":KEY 10,")":C1=0:I=0:CLS:GOSUB 11300:LOCATE 5,29:COLOR 15,0:PRINT"DO YOU WANT TO DISPLAY":COLOR 7,0
  63. 3040  LOCATE 8,32:PRINT"1. By record number"
  64. 3060  LOCATE 9,32:PRINT"2. By name"
  65. 3080  LOCATE 10,32:PRINT"3. All"
  66. 3100  GOSUB 11150:LOCATE 19,24:PRINT"Type the number of your choice  ";:LOCATE 19,POS(0)-1:IPC=1:PT=0:OF=1:GOSUB 15150:IF IP$=ESC$ THEN 520 ELSE IF VAL(IP$)=0 THEN 3120 ELSE I=VAL(IP$)
  67. 3120  IF I<1 OR I>3 THEN LOCATE 23,24:BEEP:COLOR 15,0:PRINT"PLEASE TYPE A NUMBER FROM 1 TO 3":COLOR 7,0:GOTO 3100
  68. 3140  ON I GOTO 3420,3160,3600,520
  69. 3160  CLS:GOSUB 11150:LOCATE 7,15:PRINT"Enter name you would like to display:";:LOCATE CSRLIN,POS(0)+1:IPC=15:PT=1:GOSUB 15150:IF IP$=ESC$ THEN 3020 ELSE SWAP I$,IP$
  70. 3170  IF LEN(I$)<>0 THEN 3180 ELSE IF I$="" THEN LOCATE 23,1:BEEP:PRINT"You did not enter a name. Do you wish to return to menu (Y/N)";:LOCATE CSRLIN,POS(0)+1:IPC=1:GOSUB 15150
  71. 3172  IF IP$="Y" OR IP$="y" THEN 3020 ELSE IF IP$=ESC$ THEN 3020 ELSE LOCATE 23,1:PRINT STRING$(68," "):GOTO 3160
  72. 3180  F$=I$
  73. 3200  OPEN "I",#1,IN$
  74. 3204  IF EOF(1) THEN 3380
  75. 3205  INPUT #1,I$
  76. 3220  I=LEN(I$):I=I-20:IF MID$(I$,6,LEN(F$))<>F$ THEN 3204 ELSE I = VAL(RIGHT$(I$,I))
  77. 3240  C1=1:GET 2,I
  78. 3260  CLS:LOCATE 1,30:PRINT"RECORD NUMBER "I
  79. 3280  GOSUB 11010:GOSUB 10500:GOSUB 10600
  80. 3320  LOCATE 23,1:PRINT"Type S to return to menu or any other key to continue search";
  81. 3340  I$=INKEY$:IF I$="" THEN 3340
  82. 3360  LOCATE 23,1:PRINT STRING$(75,32);:IF LEFT$(I$,1)="S" OR LEFT$(I$,1)="s" THEN 3380
  83. 3370  GOTO 3204
  84. 3380  CLOSE 1
  85. 3381  IF C1=1 THEN 3400
  86. 3382  LOCATE 23,10:BEEP:PRINT"There is no record for ";:COLOR 0,7:PRINT" "F$" ";:COLOR 7,0:PRINT" press any key to continue";
  87. 3384  I$=INKEY$:IF I$="" THEN 3384
  88. 3400  GOTO 3020
  89. 3420  CLS:GOSUB 11150
  90. 3421  LOCATE 7,15:PRINT"Enter record number you would like to display:     ";:LOCATE 7,POS(0)-4:IPC=4:PT=1:OF=1:GOSUB 15150:IF IP$=ESC$ THEN 3020
  91. 3422  IF VAL(IP$)=0 THEN LOCATE 23,1:PRINT SPACE$(77);:LOCATE 23,22:BEEP:PRINT"Record number must be numeric":GOTO 3421:ELSE I=VAL(IP$)
  92. 3423  IF I>N THEN LOCATE 23,1:BEEP: PRINT"There are only"N;"records in the file. Please choose a number no larger than"N;:GOTO 3421
  93. 3424  IF I=0 THEN 3020
  94. 3426  'IF N=0 THEN BEEP:LOCATE 23,1:PRINT"There are no records in this file. Press enter to continue";:IPC=1:PT=0:OF=0:GOSUB 15150:GOTO 520
  95. 3440  GET 2,I
  96. 3460  CLS:LOCATE 1,30:PRINT"RECORD NUMBER "I
  97. 3480  GOSUB 11010:GOSUB 10500:GOSUB 10600
  98. 3500  LOCATE 23,1:PRINT"Press any key to continue"
  99. 3520  I$=INKEY$:IF I$="" THEN 3520 ELSE LOCATE 23,1:PRINT STRING$(75,32);
  100. 3540  GOTO 3020
  101. 3600  CLS:LOCATE 1,30:PRINT "RECORD NUMBER ";:GOSUB 11010:IF S=1 THEN OPEN "I",#1,SRT$:GOTO 3606
  102. 3605  FOR L=1 TO N
  103. 3606  IF S=1 THEN IF EOF(1) GOTO 3840
  104. 3607  IF S=1 THEN INPUT #1,I:GOTO 3640
  105. 3620  I=L
  106. 3640  GET 2,I
  107. 3660  LOCATE 1,44:PRINT USING "####";I
  108. 3680  GOSUB 10500:GOSUB 10600
  109. 3700  FOR T=1 TO 15
  110. 3720  GOSUB 11150:LOCATE 25,59:COLOR 15,0:PRINT"F10 ";:COLOR O,7:PRINT" TO HOLD DISPLAY ";:COLOR 7,0
  111. 3740  I$=INKEY$:IF I$<>"" THEN IF I$=")" THEN LOCATE 25,63:COLOR 0,7:PRINT" TO CONTINUE ";:COLOR 7,0:PRINT"    ";:IPC=1:OF=0:GOSUB 15150
  112. 3745  IF I$=ESC$ THEN IF S=1 GOTO 3860 ELSE T=15:L=N
  113. 3780  NEXT T
  114. 3785  IF S=1 THEN 3606
  115. 3800  NEXT L
  116. 3820  IF I$=ESC$ THEN 3860
  117. 3840  LOCATE 23,20:BEEP:PRINT"End of file. Type any key to return";:IPC=1:PT=O:OF=0:GOSUB 15150
  118. 3860  CLOSE 1:I1$="":GOTO 3020
  119. 4000  ' --------------------------- CORRECTION ROUTINE -------------------------
  120. 4020  I=0:MN=4:F1=2:C1=0:X=0
  121. 4040  CLS:GOSUB 11300:COLOR 15,0:LOCATE 5,29:PRINT"DO YOU WANT TO CORRECT":COLOR 7,0:LOCATE 8,30:PRINT"1. By record number"
  122. 4060  LOCATE 9,30:PRINT"2. By name"
  123. 4080  GOSUB 11150:LOCATE 19,25:PRINT"Type the number of your choice  ";:LOCATE 19,POS(0)-1:IPC=1:PT=0:OF=1:GOSUB 15150:IF IP$=ESC$ THEN 4560 ELSE IF VAL(IP$)=0 THEN 4100 ELSE I=VAL(IP$)
  124. 4085  'IF I$=ESC$ THEN GOTO 4560
  125. 4100  IF I<1 OR I>2 THEN LOCATE 23,27:BEEP:COLOR 15,0:PRINT"PLEASE TYPE NUMBER 1  OR 2":COLOR 7,0:GOTO 4080
  126. 4120  IF I = 2 GOTO 4280
  127. 4140  CLS:GOSUB 11150
  128. 4160  LOCATE 7,15:PRINT"Enter the number of record you want to correct:     ";:LOCATE 7,POS(0)-4:IPC=4:PT=1:OF=1:GOSUB 15150:IF IP$=ESC$ THEN 4020
  129. 4162  IF VAL(IP$)=0 THEN LOCATE 23,1:PRINT SPACE$(77);:LOCATE 23,22:BEEP:PRINT"Record number must be numeric":GOTO 4160:ELSE I1=VAL(IP$)
  130. 4180  IF I1>N THEN LOCATE 23,1:BEEP:PRINT"No record found for that number. Do you want to try another ";:LOCATE 23,POS(0)-1:IPC=1:PT=O:OF=0:GOSUB 15150:IF LEFT$(IP$,1)="Y" OR LEFT$(IP$,1)="y" THEN 4140 ELSE GOTO 4560
  131. 4200  CLS:LOCATE 1,30:PRINT"RECORD NUMBER "I1
  132. 4220  GET 2,I1
  133. 4240  GOSUB 11010:GOSUB 10500:GOSUB 10600:GOTO 1080
  134. 4242  OPEN "I",1,IN$
  135. 4245  FOR L=1 TO N
  136. 4247  INPUT #1,I1$
  137. 4249  I2=LEN(I1$):I2=I2-20:IF VAL(RIGHT$(I1$,I2))=I1 THEN I$(L)=Z$+N2$+STR$(I1) ELSE I$(L)=I1$
  138. 4251  NEXT L
  139. 4253  CLOSE 1
  140. 4255  GOSUB 10400:GOSUB 10200
  141. 4260  GOTO 4040
  142. 4280  CLS:F1=3:GOSUB 11150
  143. 4300  LOCATE 5,15:PRINT"Enter last name of record you want to correct:";:LOCATE 5,POS(0)+1:IPC=15:PT=1:OF=1:GOSUB 15150:IF IP$=ESC$ THEN 4020 ELSE SWAP IP$,I$:IF I$="" THEN 4020
  144. 4320  F$=I$
  145. 4340  OPEN "i",1,IN$:OPEN "B:TEMP" FOR APPEND AS 3
  146. 4342  FOR L2= 1 TO N
  147. 4344  INPUT#1,I$:Q=Q+1
  148. 4360  I1=LEN(I$):I1=I1-20:IF MID$(I$,6,LEN(F$))<>F$ THEN I$(Q)=I$:GOTO 4427
  149. 4365  I1=VAL(RIGHT$(I$,I1))
  150. 4380  C1=1:GET 2,I1
  151. 4400  CLS:LOCATE 1,30:PRINT"RECORD NUMBER "I1
  152. 4420  GOSUB 11010:GOSUB 10500:GOSUB 10600:GOTO 1080
  153. 4425  I$(Q)=Z$+N2$+STR$(I1):GOSUB 10200
  154. 4427  IF Q=100 THEN GOSUB 4600
  155. 4440  NEXT L2
  156. 4445  CLOSE 1
  157. 4447  GOSUB 4600:CLOSE 3
  158. 4460  IF C1=1 THEN 4500
  159. 4480  LOCATE 23,1:BEEP:PRINT"There is no record for ";:COLOR 0,7:PRINT" "F$" ";:COLOR 7,0:PRINT". Type any key to continue";:KILL "B:TEMP":GOTO 4520
  160. 4500  LOCATE 23,1:BEEP:PRINT"End of records for ";:COLOR 0,7:PRINT" "F$" ";:COLOR 7,0:PRINT". Type any key to continue";
  161. 4520  I$=INKEY$:IF I$="" THEN 4520 ELSE IF C1=0 THEN 4040
  162. 4540  KILL IN$:GOSUB 4700:GOTO 4040
  163. 4560  F1=0:GOTO 520
  164. 4600  FOR L1=1 TO Q
  165. 4620  PRINT#3,I$(L1)
  166. 4640  NEXT L1
  167. 4660  Q=0:RETURN
  168. 4700  Q=0:OPEN "I",3,"B:TEMP"
  169. 4720  OPEN IN$ FOR APPEND AS 1
  170. 4740  FOR L=1 TO N
  171. 4760  Q=Q+1
  172. 4780  INPUT#3,I1$(Q)
  173. 4800  IF Q=100 THEN GOSUB 4900
  174. 4820  NEXT L
  175. 4840  GOSUB 4900:CLOSE 1,3:KILL "B:TEMP":RETURN
  176. 4900  FOR L1=1 TO Q
  177. 4920  PRINT#1,I1$(L1)
  178. 4940  NEXT L1
  179. 4960  Q=0:RETURN
  180. 5000  '---------------------PRINTER ROUTINE --------------------------------
  181. 5020  KEY 10,")":I=0:MN=5:FOR L=1 TO 3:P$(L)=SPACE$(80):NEXT L:P$=SPACE$(80):A$=SPACE$(15):A1$=SPACE$(15):C1=0:CLS:GOSUB 11300:COLOR 15,0:LOCATE 5,29:PRINT"DO YOU WANT TO PRINT":COLOR 7,0
  182. 5025  LOCATE 8,31:PRINT"1 By record number"
  183. 5030  LOCATE 9,31:PRINT"2 By name"
  184. 5035  LOCATE 10,31:PRINT"3 All"
  185. 5050  GOSUB 11150:LOCATE 19,23:PRINT"Type the number of your choice: ";:IPC=1:PT=0:OF=1:GOSUB 15150:IF IP$=ESC$ THEN 520 ELSE IF VAL(IP$)=0 THEN 5055 ELSE I=VAL(IP$)
  186. 5055  IF I<1 OR I>3 THEN LOCATE 23,23:BEEP:COLOR 15,0:PRINT"PLEASE TYPE A NUMBER FROM 1 TO 3":COLOR 7,0:GOTO 5050
  187. 5060  ON I GOTO 5065,5140,5520
  188. 5065  CLS:GOSUB 11150:LOCATE 7,15:PRINT"Enter name you would like to print ";:IPC=15:PT=1:OF=1:GOSUB 15150:IF IP$=ESC$ THEN 5020 ELSE SWAP IP$,I$
  189. 5067  IF I$="" THEN 5020
  190. 5070  F$=I$
  191. 5073  OPEN "I",#1,IN$
  192. 5075  IF EOF(1) THEN 5115
  193. 5077  INPUT#1,I$
  194. 5080  I=LEN(I$):I=I-20:IF MID$(I$,6,LEN(F$))<>F$ THEN 5075 ELSE I = VAL(RIGHT$(I$,I))
  195. 5085  C1=1:GET 2,I
  196. 5090  CLS:LOCATE 1,30:PRINT"RECORD NUMBER "I
  197. 5095  GOSUB 5495
  198. 5100  LOCATE 23,1:PRINT"Type S to return to menu or any other key to continue search";
  199. 5105  I$=INKEY$:IF I$="" THEN 5105
  200. 5110  LOCATE 23,1:PRINT STRING$(75,32);:IF LEFT$(I$,1)="S" OR LEFT$(I$,1)="s" THEN CLOSE 1:GOTO 5020
  201. 5113  GOTO 5075
  202. 5115  CLOSE 1
  203. 5120  IF C1=1 THEN 5135
  204. 5125  LOCATE 23,1:BEEP:PRINT"There is no record for ";:COLOR 0,7:PRINT" "F$" ";:COLOR 7,0:PRINT" press any key to continue";
  205. 5130  I$=INKEY$:IF I$="" THEN 5130
  206. 5135  GOTO 5020
  207. 5140  CLS:GOSUB 11150
  208. 5141  LOCATE 7,15:PRINT"Enter record number you would like to print ";:IPC=4:PT=1:OF=1:GOSUB 15150:IF IP$=ESC$ THEN 5020 ELSE I=VAL(IP$)
  209. 5142  IF I=0 THEN 5020
  210. 5145  IF I>N THEN LOCATE 23,1:BEEP:PRINT"There are only"N"records in the file. Please choose a number no larger than"N:GOTO 5141
  211. 5150  'IF N=0 THEN BEEP:LOCATE 22,1:INPUT"THERE ARE NO RECORDS IN THIS FILE. PRESS ENTER TO CONTINUE",I$:GOTO 520
  212. 5155  GET 2,I
  213. 5160  CLS:LOCATE 1,30:PRINT"RECORD NUMBER "I
  214. 5165  GOSUB 5495:GOSUB 10500
  215. 5170  LOCATE 23,1:PRINT"Type any key to continue";
  216. 5175  I$=INKEY$:IF I$="" THEN 5175 ELSE LOCATE 23,1:PRINT STRING$(75,32);
  217. 5180  GOTO 5020
  218. 5280  '----------------------- PRINT 3-WIDE LABELS------------------------------
  219. 5285  GOSUB 5910:GOSUB 5950:P=0:KEY 10,")":CLS:LOCATE 10,35:PRINT"PRINTING":IF S=1 THEN OPEN "I",1,SRT$ ELSE OPEN "I",1,IN$
  220. 5287  IF S=1 THEN INPUT#1,I ELSE INPUT#1,I$
  221. 5290  P = P+1
  222. 5295  IF S<>1 THEN I=LEN(I$):I=I-20:I=VAL(RIGHT$(I$,I))
  223. 5300  GET 2,I
  224. 5305  MID$(P$(P),1)=N1F$+N2F$+PHF$+STF$+CF$+SF$+" "+ZF$
  225. 5310  IF EOF(1) THEN IF P <2 THEN P$(2)="":P$(3)="":GOTO 5325
  226. 5315  IF EOF(1) THEN IF P <3 THEN P$(3)="":GOTO 5325
  227. 5320  IF P <> 3 GOTO 5465         'MUST GET 3 RECORDS BEFORE PRINTING
  228. 5325   FOR L1=1 TO 3
  229. 5330  MID$(A$,1)=MID$(P$(L1),11,15)       'DUMMY FOR LAST NAMES IF NOT THREE
  230. 5335  IF P$(L1)="" THEN 5355
  231. 5340   LPRINT MID$(P$(L1),1,INSTR(P$(L1),"\")-1);" ";MID$(A$,1,INSTR(A$,"\")-1); 'FIRST AND LAST NAMES --PHONE NOT USED
  232. 5345  IF L1 = 1 THEN LPRINT TAB(TAB1);
  233. 5350  IF L1 = 2 THEN LPRINT TAB(TAB2);
  234. 5355  NEXT L1
  235. 5360  LPRINT
  236. 5365  FOR L1=1 TO 3
  237. 5370  IF P$(L1)="" THEN 5390
  238. 5375  LPRINT MID$(P$(L1),38,20);  'STREET ADDRESS
  239. 5380  IF L1 = 1 THEN LPRINT TAB(TAB1);
  240. 5385  IF L1 = 2 THEN LPRINT TAB(TAB2);
  241. 5390  NEXT L1
  242. 5395  LPRINT
  243. 5400  FOR L1 = 1 TO 3
  244. 5405  IF P$(L1)="" THEN 5430
  245. 5410  MID$(A1$,1)=MID$(P$(L1),58,15)
  246. 5415  LPRINT MID$(A1$,1,INSTR(A1$,"\")-1);", ";RIGHT$(P$(L1),8); 'CITY,STATE,ZIP
  247. 5420  IF L1 = 1 THEN LPRINT TAB(TAB1);
  248. 5425  IF L1 = 2 THEN LPRINT TAB(TAB2);
  249. 5430  NEXT L1
  250. 5435  FOR BLINES=0 TO SPACES:IF SPACES =0 THEN 5437 ELSE LPRINT
  251. 5437  NEXT
  252. 5440  GOSUB 11150:LOCATE 25,59:COLOR 15,0:PRINT"10 ";:COLOR 0,7:PRINT" TO HOLD PRINTING ";:COLOR 7,0
  253. 5445  I1$=INKEY$:IF I1$<>"" THEN IF I1$=")" THEN LOCATE 25,63:COLOR 0,7:PRINT"TO CONTINUE ";:COLOR 7,0:PRINT"     ";:IPC=1:OF=0:GOSUB 15150
  254. 5450  IF I1$ = ESC$ THEN GOSUB 5960:GOTO 5470
  255. 5460  P=0:I1$=""
  256. 5465  IF EOF(1)=0 THEN 5287
  257. 5470  GOSUB 5960:CLOSE 1:CLS:GOTO 5520
  258. 5490  GET 2,I
  259. 5495  LPRINT MID$(N1F$,1,INSTR(N1F$,"\")-1);" ";MID$(N2F$,1,INSTR(N2F$,"\")-1)
  260. 5500  LPRINT STF$
  261. 5505  LPRINT MID$(CF$,1,INSTR(CF$,"\")-1);", ";SF$;" ";ZF$
  262. 5507  IF SPACES=<0 THEN 5515
  263. 5510  FOR BLINES=1 TO SPACES:LPRINT
  264. 5512  NEXT
  265. 5515  RETURN
  266. 5520  I=0:MN=7:CLS:GOSUB 11300:COLOR 15,0:LOCATE 5,23:PRINT "THE FOLLOWING OPTIONS ARE AVAILABLE":COLOR 7,0
  267. 5525  LOCATE 8,31:PRINT "1 Listing"
  268. 5530  LOCATE 9,31:PRINT "2 Labels - 1 Wide"
  269. 5535  LOCATE 10,31:PRINT "3 Labels - 2 Wide"
  270. 5540  LOCATE 11,31:PRINT "4 Labels - 3 Wide"
  271. 5550  LOCATE 19,23:PRINT"Type the number of your choice:":GOSUB 11100
  272. 5552  IF I$=ESC$ THEN 5020
  273. 5555  IF I<1 OR I>4 THEN LOCATE 23,23:BEEP:COLOR 15,0:PRINT"PLEASE TYPE A NUMBER FROM 1 TO 4":COLOR 7,0:GOTO 5550
  274. 5560  ON I GOTO 5562,5655,5680,5285
  275. 5561  '---------------------- LISTING - SUBROUTINE -----------------------------
  276. 5562  CLS:GOSUB 11150:LOCATE 7,15:PRINT"Enter title for listing: ";:IPC=40:PT=1:OF=1:GOSUB 15150:IF I$=ESC$ THEN 5520 ELSE IF LEN(IP$)=0 THEN 5520 ELSE SWAP TITLE$,IP$
  277. 5563  LPRINT :LPRINT CHR$(14);TITLE$;:LPRINT CHR$(20);'TAB(50)DATE$
  278. 5565  CLS:LOCATE 10,35:PRINT"PRINTING"
  279. 5570  LPRINT CHR$(15):WIDTH "LPT1:",132:LPRINT CHR$(27);"0"
  280. 5575  LPRINT TAB(100) DATE$ :LPRINT :LPRINT
  281. 5580  LPRINT "       NAME";TAB(38)"PHONE";TAB(59)"STREET";TAB(80);"CITY";TAB(95) "ST   ZIP"
  282. 5585  LPRINT STRING$(103,208):LPRINT
  283. 5587  IF S=1 THEN OPEN "i",1,SRT$:GOTO 5592
  284. 5590  FOR L= 1 TO N
  285. 5592  IF S=1 THEN IF EOF(1) GOTO 5645
  286. 5595  IF S=1 THEN INPUT#1,I:GOTO 5610
  287. 5605  I=L
  288. 5610  GET 2,I
  289. 5615  MID$(P$,1)=N1F$+N2F$+PHF$+STF$+CF$+SF$+" "+ZF$
  290. 5620  LPRINT MID$(P$,1,INSTR(P$,"\")-1);:LPRINT TAB(16) MID$(P$,11,INSTR(11,P$,"\")-11) TAB(33) MID$(P$,26,12);:LPRINT TAB(56) MID$(P$,38,20);:LPRINT TAB(78) MID$(P$,58,INSTR(58,P$,"\")-58);:LPRINT TAB(95) MID$(P$,73,2);" ";RIGHT$(P$,5)
  291. 5625  GOSUB 11150:LOCATE 25,59:COLOR 15,0:PRINT"10 ";:COLOR 0,7:PRINT" to hold printing ";:COLOR 7,0
  292. 5630  I$=INKEY$:IF I$<>"" THEN IF I$=")" THEN LOCATE 25,63:COLOR 0,7:PRINT"to continue ";:COLOR 7,0:PRINT"     ";:IPC=1:OF=0:PT=0:GOSUB 15150
  293. 5635  IF I$=ESC$ THEN IF S=1 GOTO 5645 ELSE L=N
  294. 5637  IF S=1 THEN 5592
  295. 5640  NEXT:LPRINT :LPRINT
  296. 5645  LPRINT CHR$(146):WIDTH "LPT1:",80:LPRINT CHR$(27);"2"
  297. 5650  CLOSE 1:GOTO 5520
  298. 5655  GOSUB 5905:CLS:LOCATE 10,35:PRINT"PRINTING":IF S=1 THEN OPEN "I",1,SRT$
  299. 5656  IF S=1 THEN IF EOF(1) GOTO 5670 ELSE INPUT#1,I:GOTO 5660
  300. 5657  FOR L=1 TO N
  301. 5659  I=L
  302. 5660  GOSUB 5490
  303. 5662  GOSUB 11150:LOCATE 25,59:COLOR 15,0:PRINT"10 ";:COLOR 0,7:PRINT" TO HOLD PRINTING ";:COLOR 7,0
  304. 5663  I$=INKEY$:IF I$<>"" THEN IF I$=")" THEN LOCATE 25,63:COLOR 0,7:PRINT"TO CONTINUE ";:COLOR 7,0:PRINT"     ";:IPC=1:OF=0:PT=0:GOSUB 15150
  305. 5664  IF I$=ESC$ THEN IF S=1 GOTO 5670 ELSE L=N
  306. 5665  IF S=1 GOTO 5656
  307. 5667  NEXT
  308. 5670  CLS:CLOSE 1:GOTO 5520
  309. 5675  '--------------------- 2-WIDE LABELS -------------------------------
  310. 5680  GOSUB 5900
  311. 5681  CLS:P=0:LOCATE 10,35:PRINT"PRINTING":IF S=1 THEN OPEN "I",1,SRT$ ELSE OPEN "I",1,IN$
  312. 5682  IF S=1 THEN INPUT#1,I ELSE INPUT#1,I$
  313. 5685  P = P+1
  314. 5690  IF S<>1 THEN I=LEN(I$):I=I-20:I=VAL(RIGHT$(I$,I))
  315. 5695  GET 2,I
  316. 5700  MID$(P$(P),1)=N1F$+N2F$+PHF$+STF$+CF$+SF$+" "+ZF$
  317. 5705  IF EOF(1) THEN IF P <2 THEN P$(2)="":GOTO 5715
  318. 5710  IF P <> 2 GOTO 5855         'MUST GET 2 RECORDS BEFORE PRINTING
  319. 5715   FOR L1=1 TO 2
  320. 5720  MID$(A$,1)=MID$(P$(L1),11,15)       'DUMMY FOR LAST NAMES IF NOT THREE
  321. 5725  IF P$(L1)="" THEN 5745
  322. 5730   LPRINT MID$(P$(L1),1,INSTR(P$(L1),"\")-1);" ";MID$(A$,1,INSTR(A$,"\")-1); 'FIRST AND LAST NAMES --PHONE NOT USED
  323. 5735  IF L1 = 1 THEN LPRINT TAB(TAB1);
  324. 5740  IF L1 = 2 THEN LPRINT TAB(TAB2);
  325. 5745  NEXT L1
  326. 5750  'LPRINT
  327. 5755  FOR L1=1 TO 2
  328. 5760  IF P$(L1)="" THEN 5780
  329. 5765  LPRINT MID$(P$(L1),38,20);  'STREET ADDRESS
  330. 5770  IF L1 = 1 THEN LPRINT TAB(TAB1);
  331. 5775  IF L1 = 2 THEN LPRINT TAB(TAB2);
  332. 5780  NEXT L1
  333. 5785  'LPRINT
  334. 5790  FOR L1 = 1 TO 2
  335. 5795  IF P$(L1)="" THEN 5820
  336. 5800  MID$(A1$,1)=MID$(P$(L1),58,15)
  337. 5805  LPRINT MID$(A1$,1,INSTR(A1$,"\")-1);", ";RIGHT$(P$(L1),8); 'CITY,STATE,ZIP
  338. 5810  IF L1 = 1 THEN LPRINT TAB(TAB1);
  339. 5815  IF L1 = 2 THEN LPRINT TAB(TAB2);
  340. 5820  NEXT L1
  341. 5825  FOR BLINES=1 TO SPACES:IF SPACES =0 THEN 5827 ELSE LPRINT
  342. 5827  NEXT
  343. 5830  GOSUB 11150:LOCATE 25,59:COLOR 15,0:PRINT"10 ";:COLOR 0,7:PRINT" TO HOLD PRINTING ";:COLOR 7,0
  344. 5835  I1$=INKEY$:IF I1$<>"" THEN IF I1$=")" THEN LOCATE 25,63:COLOR 0,7:PRINT"TO CONTINUE ";:COLOR 7,0:PRINT"     ";:IPC=1:OF=0:GOSUB 15150
  345. 5840  IF I1$ = ESC$ THEN GOSUB 5960 :GOTO 5470
  346. 5850  P=0:I1$=""
  347. 5855  IF EOF(1) = 0 THEN 5682
  348. 5860  CLOSE 1:CLS:GOTO 5520
  349. 5899  '-----------------------SET TABS SUBROUTINE -----------------------------
  350. 5900  CLS:GOSUB 11150:LOCATE 1,1:PRINT"Enter the FIRST print position for the second label:  ";:LOCATE 1,POS(0)-1:IPC=3:PT=1:GOSUB 15150:IF IP$=ESC$ THEN 5520 ELSE TAB1=VAL(IP$)
  351. 5905  CLS:GOSUB 11150:LOCATE 1,1:PRINT"Enter the number of spaces you desire between labels:  ";:LOCATE 1,POS(0)-1:IPC=3:PT=1:GOSUB 15150:IF IP$=ESC$ THEN 5520 ELSE SPACES=VAL(IP$):RETURN
  352. 5910  CLS:GOSUB 11150:LOCATE 1,1:PRINT"Enter the FIRST print position for the second label:  ";:LOCATE 1,POS(0)-1:IPC=3:PT=1:GOSUB 15150:IF IP$=ESC$ THEN 5520 ELSE TAB1=VAL(IP$)
  353. 5920  LOCATE 3,1:PRINT"Enter the FIRST print position for the third label:  ";:LOCATE 3,POS(0)-1:IPC=3:PT=1:GOSUB 15150:IF IP$=ESC$ THEN 5520 ELSE TAB2=VAL(IP$)
  354. 5930  GOSUB 11150:LOCATE 5,1:PRINT"Enter the number of spaces you desire between labels:  ";:LOCATE 5,POS(0)-1:IPC=3:PT=1:GOSUB 15150:IF IP$=ESC$ THEN 5520 ELSE SPACES=VAL(IP$):RETURN
  355. 5950  LPRINT CHR$(15);:WIDTH "LPT1:",132:RETURN
  356. 5960  LPRINT CHR$(146):WIDTH "LPT1:",80:RETURN
  357. 6000  ' ---------------------- DELETE ROUTINE ---------------------------------
  358. 6020  I=0:MN=6:KEY 9,"":KEY 10,"":CLS:GOSUB 11300
  359. 6040  LOCATE 5,30:COLOR 15,0:PRINT"DO YOU WANT TO DELETE":COLOR 7,0
  360. 6060  LOCATE 8,32:PRINT"1 By record number"
  361. 6080  LOCATE 9,32:PRINT"2 By last name"
  362. 6100  GOSUB 11150:LOCATE 19,25:PRINT"Type the number of your choice: ";:IPC=1:PT=0:OF=1:GOSUB 15150:IF IP$=ESC$ THEN 6145 ELSE IF VAL(IP$)=0 THEN 6120 ELSE I=VAL(IP$)
  363. 6120  IF I<1 OR I>2 THEN LOCATE 23,26:BEEP:COLOR 15,0:PRINT"PLEASE TYPE NUMBER 1 OR 2":COLOR 7,0:GOTO 6100
  364. 6140  IF I=1 THEN 6155 ELSE IF I=2 THEN 6440
  365. 6145  OPEN "O",3,NBR$:PRINT#3,N:CLOSE 3:IF S=1 THEN S=0:KILL SRT$ ELSE GOTO 520
  366. 6155  CLS:GOSUB 11150
  367. 6160  LOCATE 7,15:PRINT"Enter record number you want to delete     ";:LOCATE 7,POS(0)-4:IPC=4:PT=1:OF=1:GOSUB 15150:IF IP$=ESC$ THEN 6020 ELSE IF IP$="" THEN BEEP:GOTO 6160 ELSE I=VAL(IP$)
  368. 6180  IF N=0 THEN BEEP:LOCATE 23,1:PRINT"There are no records in this file. Press enter to continue ";:IPC=1:PT=0:OF=0:GOTO 520
  369. 6185  IF I>N THEN LOCATE 23,1:BEEP:PRINT"There are only"N"records in the file. Please enter a number no larger than"N:GOTO 6160
  370. 6190  IF I=0 THEN GOTO 6020
  371. 6200  GET 2,I
  372. 6300  CLS:LOCATE 1,30:PRINT"RECORD NUMBER "I
  373. 6320  GOSUB 11010:GOSUB 10500:GOSUB 10600
  374. 6325  GOSUB 11150
  375. 6340  LOCATE 22,1:BEEP:PRINT"Is this the correct record to delete ";:IPC=1:PT=0:OF=1:GOSUB 15150:IF IP$=ESC$ THEN 6020 ELSE SWAP IP$,I$
  376. 6360  IF I$="N" OR I$="n" THEN 6020 ELSE IF I$="Y" OR I$="y" THEN 6420
  377. 6400  LOCATE 23,1:BEEP:PRINT"You must enter yes or no. Please reenter":GOTO 6340
  378. 6420  GOSUB 6760:N=N-1:GOTO 6020
  379. 6440  CLS:C1=0:GOSUB 11150
  380. 6460  LOCATE 5,15:PRINT"Enter last name of record you want to delete ";:IPC=15:PT=1:OF=1:GOSUB 15150:IF IP$=ESC$ THEN 6020 ELSE IF IP$="" THEN BEEP:GOTO 6460 ELSE SWAP IP$,I$
  381. 6480  F$=I$
  382. 6485  OPEN "I",1,IN$
  383. 6505  IF EOF(1) THEN GOTO 6682 ELSE INPUT#1,IP$
  384. 6520  I=LEN(IP$):I=I-20:IF MID$(IP$,6,LEN(F$))<>F$ THEN 6680 ELSE I=VAL(RIGHT$(IP$,I))
  385. 6540  GET 2,I
  386. 6560  CLS:LOCATE 1,30:PRINT"RECORD NUMBER "I
  387. 6580  GOSUB 11010:GOSUB 10500:GOSUB 10600
  388. 6600  I1$=" ":GOSUB 11150:LOCATE 22,1:BEEP:PRINT"Is This the correct record to delete ";:IPC=1:PT=0:OF=1:GOSUB 15150:IF IP$=ESC$ THEN 6020 ELSE SWAP IP$,I1$
  389. 6640  IF I1$="Y" OR I1$="y" THEN 6700 ELSE IF I1$="N" OR I1$="n" THEN 6680
  390. 6660  LOCATE 23,1:BEEP:PRINT"You must enter yes or no. Please reenter":GOTO 6600
  391. 6680  GOTO 6505
  392. 6682  CLOSE 1:GOTO 6020
  393. 6700  CLOSE 1:GOSUB 6760:N=N-1:GOTO 6020
  394. 6750  ' -------------- ACTUAL DELETE ROUTINE ------------
  395. 6760  OPEN "i",1,IN$
  396. 6800  FOR L1=1 TO N
  397. 6820  INPUT#1,I1$
  398. 6840  IF L1<I GOTO 6920
  399. 6860  GET 2,L1+1
  400. 6880  PUT 2,L1
  401. 6900  IF L1=I GOTO 6940
  402. 6905  I2$=LEFT$(I1$,20)
  403. 6910  I1$=I2$+STR$(L1-1)
  404. 6920  IF L1<I THEN I$(L1)=I1$ ELSE IF L1>I THEN I$(L1-1)=I1$
  405. 6940  NEXT L1
  406. 6960  CLOSE 1
  407. 6968  OPEN "O",1,IN$
  408. 6972  FOR L1=1 TO N-1
  409. 6980  PRINT#1,I$(L1)
  410. 6984  NEXT L1
  411. 6988  CLOSE 1,3
  412. 6992  RETURN
  413. 7020  CLS:CLOSE:IF S=1 THEN KILL SRT$
  414. 7021  SYSTEM
  415. 8000  ' -------------------------DUP ROUTINE ----------------------------------
  416. 8020  IF F1=2 OR F1 = 3 THEN RETURN ELSE N11$=N1$:N21$=N2$:P1H$=PH$:S1T$=ST$:C1$=C$:S1$=S$:Z1$=Z$' SAVE NAMES
  417. 8022  IF N=1 THEN RETURN
  418. 8024  C3=0:C2=0
  419. 8030  OPEN "i",#1,IN$
  420. 8034  IF EOF(1) THEN CLOSE 1:GOTO 8262
  421. 8036  INPUT#1,I$
  422. 8040  IF N21$<>MID$(I$,6,15) THEN 8034
  423. 8060  I=VAL(RIGHT$(I$,LEN(I$)-20))
  424. 8080  GET 2,I
  425. 8100  CLS:LOCATE 1,30:PRINT"RECORD NUMBER "I
  426. 8120  GOSUB 11010:GOSUB 10500:GOSUB 10600
  427. 8140  LOCATE 20,1:PRINT"This is a possible duplicate of ";:PRINT MID$(N11$,1,INSTR(N11$,"\")-1)" ";:PRINT MID$(N21$,1,INSTR(N21$,"\")-1)
  428. 8160  BEEP:LOCATE 22,1:PRINT"Is this a duplicate entry? ";:IPC=1:PT=0:OF=1:GOSUB 15150:IF IP$=ESC$ THEN 520 ELSE SWAP I$,IP$
  429. 8180  IF I$="Y" OR I$="y" THEN C2=1:GOTO 8262
  430. 8200  IF I$="N" OR I$="n" THEN C3=1:GOTO 8240
  431. 8220  LOCATE 23,1:BEEP:PRINT"YOU MUST ANSWER YES OR NO. PLEASE REENTER":FOR T=1 TO 1000:NEXT T:GOTO 8160
  432. 8240  LOCATE 20,1:PRINT STRING$(50,32):LOCATE 22,1:PRINT STRING$(50,32):LOCATE 23,1:PRINT STRING$(50,32)
  433. 8260  GOTO 8034
  434. 8262  IF C2=1 THEN N=N-1:GOTO 8280
  435. 8263  IF C3=0 THEN RETURN
  436. 8265  IF C2=0 THEN N1$=N11$:N2$=N21$:PH$=P1H$:ST$=S1T$:C$=C1$:S$=S1$:Z$=Z1$
  437. 8266  IF F=1 THEN GOTO 8280
  438. 8267  CLS:LOCATE 1,30:PRINT"RECORD NUMBER "N
  439. 8269  GOSUB 11010:GOSUB 10600
  440. 8280  CLOSE 1:RETURN
  441. 9999  '-----------------------ERROR TRAPS AND SUBROUTINES----------------------
  442. 10000  IF ERR = 53 THEN GOTO 10150 ELSE IF ERR = 67 GOTO 10181
  443. 10002  IF ERR=25 THEN CLS:LOCATE 12,10:PRINT "MAKE PRINTER READY THEN HIT ANY KEY TO RESUME":GOTO 10004
  444. 10003  GOTO 10006
  445. 10004  EE$=INKEY$:IF EE$="" THEN 10004 ELSE CLS:LOCATE 10,35:PRINT"PRINTING":RESUME
  446. 10006  IF ERR=27 THEN CLS:LOCATE 12,10:PRINT "REPLACE PAPER IN PRINTER THEN HIT ANY KEY TO RESUME":GOTO 10008
  447. 10007  GOTO 10010
  448. 10008  EE$=INKEY$:IF EE$="" THEN 10008 ELSE RESUME
  449. 10010  IF ERR=61 THEN CLS ELSE GOTO 10020
  450. 10012  LOCATE 11,30:PRINT"DATA DISK IS FULL."
  451. 10014  LOCATE 12,30:PRINT"LAST ENTRY MAY NOT"
  452. 10016  LOCATE 13,30:PRINT"HAVE BEEN ADDED."
  453. 10017  LOCATE 14,30:INPUT"PRESS ENTER TO RESUME.",I$:RESUME 520
  454. 10020  IF ERR = 71 THEN CLS ELSE GOTO 10120
  455. 10025  ER=1:LOCATE 10,30:PRINT"DISK DRIVE NOT READY"
  456. 10040  LOCATE 11,30:PRINT"PLEASE INSERT DATA DISK"
  457. 10060  LOCATE 12,30:PRINT"OR CLOSE DRIVE DOOR":BEEP
  458. 10080  LOCATE 13,30:INPUT"PRESS ENTER TO RESUME",I$:IF MN=3 THEN CLS:LOCATE 1,30:PRINT"RECORD NUMBER":GOSUB 11010
  459. 10100  RESUME
  460. 10120  ON ERROR GOTO 0
  461. 10150  CLS:LOCATE 12,15:PRINT"File not found. Do you wish to create a new file? ";:IPC=1:PT=0:OF=1:GOSUB 15150
  462. 10160  IF I$="Y" OR I$="y" THEN RESUME 410
  463. 10170  LOCATE 15,20:COLOR 0,7:PRINT "THE CURRENT FILES ON DISK B ARE:":LOCATE 17,1:COLOR 7,0:FILES "B:*.*"
  464. 10172  LOCATE 25,20:COLOR 0,7:PRINT "** PRESS ANY KEY TO CONTINUE **";:COLOR 7,0
  465. 10175  A$=INKEY$:IF A$="" THEN 10175
  466. 10180  CLOSE:ERASE I$:ERASE I1$:RESUME 103
  467. 10181  CLS:BEEP:LOCATE 20,20:PRINT"File name entered:";:COLOR 15,0:LOCATE 20,POS(0)+1:PRINT RIGHT$(RAN$,LEN(RAN$)-2):COLOR 7,0:LOCATE 22,10:PRINT"You have entered an invalid character in the file name."
  468. 10182  LOCATE 23,10:PRINT"Please press any key to return to file selection."
  469. 10183  I$=INKEY$:IF I$="" THEN 10183 ELSE CLS:RESUME 103
  470. 10199  ' ---------------------- WRITE R-A FILE TO DISK -----------------
  471. 10200  LSET CF$=C$
  472. 10220  LSET SF$=S$
  473. 10240  LSET ZF$=Z$
  474. 10260  LSET PHF$=PH$
  475. 10280  LSET STF$=ST$
  476. 10300  LSET N1F$=N1$
  477. 10320  LSET N2F$=N2$
  478. 10340  IF F1 = 2 OR F1=3 THEN PUT 2,I1 ELSE PUT #2,N
  479. 10360  RETURN
  480. 10399  ' --------------------------WRITE INDEX FILE TO DISK --------------------
  481. 10400  OPEN "O",#1,IN$
  482. 10420  FOR L=1 TO N:PRINT#1,I$(L):NEXT L
  483. 10440  CLOSE #1:RETURN
  484. 10500  MID$(C$,1)=CF$:MID$(S$,1)=SF$:MID$(Z$,1)=ZF$:MID$(PH$,1)=PHF$:MID$(ST$,1)=STF$:MID$(N1$,1)=N1F$:MID$(N2$,1)=N2F$:' CONVERT RA FILES TO REGULAR VARIABLES
  485. 10520  RETURN
  486. 10599  ' ------------------------ PRINT FIELD VALUES -------------------------
  487. 10600  COLOR 0,7:LOCATE 3,12:PRINT" ";:PRINT MID$(N1$,1,INSTR(N1$,"\")-1);:PRINT" ";:COLOR 7,0:PRINT STRING$(12-INSTR(N1$,"\"),32):COLOR 0,7:
  488. 10602  LOCATE 3,40:PRINT" ";:PRINT MID$(N2$,1,INSTR(N2$,"\")-1);:PRINT" ";:COLOR 7,0:PRINT STRING$(16-INSTR(N2$,"\"),32):COLOR 0,7:LOCATE 9,7:PRINT PH$:LOCATE 5,16:PRINT" ";:PRINT ST$
  489. 10605  LOCATE 7,6:PRINT" ";:PRINT MID$(C$,1,INSTR(C$,"\")-1);:PRINT" ";:COLOR 7,0:PRINT STRING$(16-INSTR(C$,"\"),32):COLOR 0,7:LOCATE 7,36:PRINT" ";:PRINT S$;:PRINT" ";:LOCATE 7,54:PRINT" ";:PRINT Z$;:PRINT" "
  490. 10620  COLOR 7,0:RETURN
  491. 11000  ' ----------------------- MAIN DISPLAY ROUTINE --------------------------
  492. 11010  LOCATE ,,0:LOCATE 3,1:PRINT"FIRST NAME:";:LOCATE 3,30:PRINT"LAST NAME:";:LOCATE 9,1:PRINT"PHONE:";:LOCATE 5,1:PRINT"STREET ADDRESS:";:LOCATE 7,1:PRINT"CITY:";:LOCATE 7,30:PRINT"STATE:";:LOCATE 7,45:PRINT"ZIP CODE:";:RETURN
  493. 11100  LOCATE 25,1:COLOR 15,0:PRINT"Esc ";:COLOR 0,7:PRINT" RETURN TO PRIOR MENU ";:COLOR 7,0
  494. 11120  I$=INKEY$:IF I$="" THEN 11120
  495. 11140  IF VAL(I$)=0 THEN RETURN ELSE I=VAL(I$):RETURN
  496. 11150  LOCATE 25,1:COLOR 15,0:PRINT"Esc ";:COLOR 0,7:PRINT" RETURN TO PRIOR MENU ";:COLOR 7,0:RETURN
  497. 11200  LOCATE 3,13:PRINT "---------      ":LOCATE 3,41:PRINT "-------------- ":LOCATE 9,7:PRINT "------------ ":LOCATE 5,17:PRINT "------------------- ":LOCATE 7,7:PRINT "-------------- ":LOCATE 7,37:PRINT "-- ":LOCATE 7,55:PRINT "----- ":RETURN
  498. 11300  LOCATE 1,34:COLOR 0,7:PRINT" MAILIST1 ":COLOR 7,0:RETURN
  499. 11400  GOSUB 11150:COUNT=0:LOCATE 3,13,1
  500. 11405  I$=INKEY$:IF I$="" THEN 11405
  501. 11410  IF I$=CHR$(9) THEN GOSUB 11510:GOTO 11405 'tab key
  502. 11415  IF LEN(I$)= 2 AND RIGHT$(I$,1)=CHR$(15) THEN GOSUB 11700:GOTO 11405 'back
  503. 11417  IF LEN(I$)=2 AND RIGHT$(I$,1)=>CHR$(16) THEN 11405
  504. 11420  IF I$=CHR$(27) THEN IF MN=4 THEN 4020 ELSE N=N-1:GOTO 520 'Escape to menu
  505. 11430  IF I$=CHR$(13) THEN 13010 'Go check input?
  506. 11435  X=CSRLIN:Y=POS(0):Y=Y-1
  507. 11440  IF I$=CHR$(8) THEN GOSUB 11810:GOTO 11405 'backspace key
  508. 11450  COUNT=COUNT+1:PRINT I$;:GOSUB 13500':PRINT I$;
  509. 11460  GOTO 11405
  510. 11500  '------------------DETERMINE FIELD AND TAB-------------------------
  511. 11510  IF CSRLIN = 3 THEN 11570
  512. 11520  IF CSRLIN = 5 THEN LOCATE 7,7:COUNT=43:RETURN
  513. 11530  IF CSRLIN = 7 THEN 11590
  514. 11540  IF CSRLIN = 9 THEN 11550
  515. 11550  IF POS(0)=>7 AND POS(0)<19 THEN LOCATE 3,13:COUNT=0:RETURN
  516. 11560  LOCATE 3,13:RETURN
  517. 11570  IF POS(0)=>13 AND POS(0) <23 THEN LOCATE 3,41:COUNT=9:RETURN
  518. 11572  IF POS(0)=>41 AND POS(0)<56 THEN LOCATE 5,17:COUNT=23:RETURN
  519. 11580  LOCATE 3,13:COUNT=0:RETURN
  520. 11590  IF POS(0)=>7 AND POS(0) <22 THEN LOCATE 7,37:COUNT=57:RETURN
  521. 11592  IF POS(0)=>37 AND POS(0)<40 THEN LOCATE 7,55:COUNT=59:RETURN
  522. 11594  IF POS(0)=>55 AND POS(0) <60 THEN LOCATE 9,7:COUNT=64:RETURN
  523. 11600  LOCATE 3,13:COUNT=0:RETURN
  524. 11700  '----------------BACK TAB ROUTINE -------------------------------------
  525. 11710  IF CSRLIN = 3 THEN 11770
  526. 11720  IF CSRLIN = 5 THEN LOCATE 3,41:COUNT=9:RETURN
  527. 11730  IF CSRLIN = 7 THEN 11790
  528. 11740  IF CSRLIN = 9 THEN LOCATE 7,55:COUNT=59:RETURN
  529. 11770  IF POS(0)=>13 AND POS(0) <23 THEN BEEP:LOCATE 3,13:COUNT=0:RETURN
  530. 11772  IF POS(0)=>41 AND POS(0)<56 THEN LOCATE 3,13:COUNT=0:RETURN
  531. 11780  LOCATE 3,67:COUNT=36:RETURN
  532. 11790  IF POS(0)=>7 AND POS(0) <22 THEN LOCATE 5,17:COUNT=23:RETURN
  533. 11792  IF POS(0)=>37 AND POS(0)<40 THEN LOCATE 7,7:COUNT=43:RETURN
  534. 11794  IF POS(0)=>55 AND POS(0) <60 THEN LOCATE 7,37:COUNT=57:RETURN
  535. 11799  LOCATE 3,13:COUNT=0:RETURN
  536. 11800  '------------------BACKSPACE -----------------------------------------
  537. 11810  IF X = 3 THEN 11870
  538. 11820  IF X = 5 THEN 11822 ELSE 11830
  539. 11822  IF POS(0)=17 THEN X=3:Y=54:GOSUB 11910:RETURN
  540. 11825  GOSUB 11920:RETURN
  541. 11830  IF X = 7 THEN 11890
  542. 11840  IF X = 9 THEN 11842
  543. 11842  IF POS(0)=7 THEN X=7:Y=59:GOSUB 11910:RETURN
  544. 11845  GOSUB 11920:RETURN
  545. 11870  IF POS(0)=13 THEN BEEP:LOCATE 3,13:COUNT=0:RETURN
  546. 11872  IF POS(0)=41 THEN Y=21:GOSUB 11910:RETURN
  547. 11880  GOSUB 11920:RETURN
  548. 11890  IF POS(0)=7 THEN X=5:Y=36:GOSUB 11910:RETURN
  549. 11892  IF POS(0)=37 THEN Y=20:GOSUB 11910:RETURN
  550. 11894  IF POS(0)=55 THEN Y=38:GOSUB 11910:RETURN
  551. 11899  GOSUB 11920:RETURN
  552. 11900  '-------------------PRINT '-' FOR BACKSPACE --------------------------
  553. 11910  LOCATE X,Y:PRINT STRING$(1,45):LOCATE X,Y:COUNT=COUNT-1:RETURN
  554. 11920  LOCATE X,Y:PRINT STRING$(1,45):LOCATE X,Y:COUNT=COUNT-1:RETURN
  555. 12010  CLOSE 2:COLOR 15,0:LOCATE 19,22:PRINT"Loading AutoDialer ..............":COLOR 7,0:CHAIN "A:AUTODIAL.BAS"
  556. 13000  '------------------READ SCREEN FOR INPUT ----------------------------
  557. 13010  CR=3:CC=13:LOCATE ,,0:I$="":TEST=0:ERRORN=0
  558. 13015  FOR L=0 TO 8
  559. 13020  IF L=0 THEN 13030 ELSE IF CHR$(SCREEN(CR,CC+L))=CHR$(45) THEN L=10:GOTO 13038
  560. 13030  I$=I$+CHR$(SCREEN(CR,CC+L))
  561. 13034  IF CHR$(SCREEN(CR,CC+L))=CHR$(32) AND TEST=0 THEN TEST=TEST+1 ELSE IF CHR$(SCREEN(CR,CC+L))=CHR$(32) AND TEST=1 THEN I$=LEFT$(I$,LEN(I$)-2):L=10:GOTO 13038
  562. 13036  IF TEST=1 AND CHR$(SCREEN(CR,CC+L))<>CHR$(32) THEN TEST=0:I1$=RIGHT$(I$,1):I$=LEFT$(I$,LEN(I$)-1)+I1$
  563. 13038  GOSUB 13684
  564. 13040  NEXT L:IF ERRORN=1 THEN GOSUB 13700:GOTO 11405
  565. 13050  N1$=STRING$(10," "):I$=I$+"\":MID$(N1$,1)=I$
  566. 13060  CC=41:I$="":TEST=0:ERRORN=0
  567. 13070  FOR L=0 TO 13
  568. 13080  IF L=0 THEN 13090 ELSE IF CHR$(SCREEN(CR,CC+L))=CHR$(45) THEN L=13:GOTO 13098
  569. 13090  I$=I$+CHR$(SCREEN(CR,CC+L))
  570. 13094  IF CHR$(SCREEN(CR,CC+L))=CHR$(32) AND TEST=0 THEN TEST=TEST+1 ELSE IF CHR$(SCREEN(CR,CC+L))=CHR$(32) AND TEST=1 THEN I$=LEFT$(I$,LEN(I$)-2):L=13:GOTO 13098
  571. 13096  IF TEST=1 AND CHR$(SCREEN(CR,CC+L))<>CHR$(32) THEN TEST=0:I1$=RIGHT$(I$,1):I$=LEFT$(I$,LEN(I$)-1)+I1$
  572. 13098  GOSUB 13684
  573. 13100  NEXT L:IF ERRORN=1 THEN GOSUB 13740:GOTO 11405
  574. 13110  MID$(N2$,1)=STRING$(15," "):I$=I$+"\":MID$(N2$,1)=I$
  575. 13120  CR=9:CC=7:I$="":ERRORN=0
  576. 13130  FOR L=0 TO 11
  577. 13140  I$=I$+CHR$(SCREEN(CR,CC+L))
  578. 13145  GOSUB 13650
  579. 13150  NEXT L:IF ERRORN=1 THEN GOSUB 13670:GOTO 11405
  580. 13155  MID$(PH$,1)=I$
  581. 13160  CR=5:CC=17:I$="":TEST=0
  582. 13170  FOR L=0 TO 19
  583. 13180  IF CHR$(SCREEN(CR,CC+L))=CHR$(45) THEN L=19:GOTO 13200
  584. 13190  I$=I$+CHR$(SCREEN(CR,CC+L))
  585. 13194  IF CHR$(SCREEN(CR,CC+L))=CHR$(32) AND TEST=0 THEN TEST=TEST+1 ELSE IF CHR$(SCREEN(CR,CC+L))=CHR$(32) AND TEST=1 THEN I$=LEFT$(I$,LEN(I$)-2):L=19:GOTO 13200
  586. 13196  IF TEST=1 AND CHR$(SCREEN(CR,CC+L))<>CHR$(32) THEN TEST=0:I1$=RIGHT$(I$,1):I$=LEFT$(I$,LEN(I$)-1)+I1$
  587. 13200  NEXT L
  588. 13210  MID$(ST$,1)=STRING$(20," "):MID$(ST$,1)=I$
  589. 13220  CR=7:CC=7:I$="":TEST=0
  590. 13230  FOR L=0 TO 13
  591. 13240  IF CHR$(SCREEN(CR,CC+L))=CHR$(45) THEN L=13:GOTO 13260
  592. 13250  I$=I$+CHR$(SCREEN(CR,CC+L))
  593. 13254  IF CHR$(SCREEN(CR,CC+L))=CHR$(32) AND TEST=0 THEN TEST=TEST+1 ELSE IF CHR$(SCREEN(CR,CC+L))=CHR$(32) AND TEST=1 THEN I$=LEFT$(I$,LEN(I$)-2):L=13:GOTO 13260
  594. 13256  IF TEST=1 AND CHR$(SCREEN(CR,CC+L))<>CHR$(32) THEN TEST=0:I1$=RIGHT$(I$,1):I$=LEFT$(I$,LEN(I$)-1)+I1$
  595. 13260  NEXT L
  596. 13270  I$=I$+"\":MID$(C$,1)=STRING$(15," "):MID$(C$,1)=I$
  597. 13280  CC=37:I$=""
  598. 13290  FOR L=0 TO 1
  599. 13300  I$=I$+CHR$(SCREEN(CR,CC+L))
  600. 13310  NEXT L
  601. 13315  MID$(S$,1)=I$
  602. 13320  CC=55:I$="":ERRORN=0
  603. 13330  FOR L=0 TO 4
  604. 13340  I$=I$+CHR$(SCREEN(CR,CC+L))
  605. 13345  GOSUB 13610
  606. 13350  NEXT L:IF ERRORN=1 THEN GOSUB 13630:GOTO 11405
  607. 13355  MID$(Z$,1)=I$
  608. 13360  RETURN
  609. 13500  '------------------CHECK COUNT FOR NEXT FIELD ----------------------
  610. 13510  IF COUNT=9 THEN BEEP:LOCATE 3,41:RETURN
  611. 13520  IF COUNT=23 THEN BEEP:LOCATE 5,17:RETURN
  612. 13530  IF COUNT=43 THEN BEEP:LOCATE 7,7:RETURN
  613. 13550  IF COUNT=57 THEN BEEP:LOCATE 7,37:RETURN
  614. 13560  IF COUNT=59 THEN BEEP:LOCATE 7,55:RETURN
  615. 13565  IF COUNT=76 THEN BEEP:LOCATE 3,13:COUNT=0:RETURN
  616. 13568  IF COUNT=64 THEN BEEP:LOCATE 9,7:RETURN
  617. 13570  IF COUNT>78 THEN BEEP:BEEP:GOTO 11400
  618. 13580  RETURN
  619. 13600  '------------------------ TEST FOR NUMERIC ZIP -------------------------
  620. 13610  I3$=CHR$(SCREEN(CR,CC+L)):IF I3$<CHR$(48) OR I3$>CHR$(57) THEN 13620 ELSE RETURN
  621. 13620  ERRORN=1:LOCATE CR,CC+L:COLOR 15,0:PRINT I3$:COLOR 7,0:RETURN
  622. 13630  LOCATE 23,1:PRINT STRING$(75,32);:LOCATE 23,25:PRINT " Zip code must be NUMERIC. ";:LOCATE 7,55,1:COUNT=59:RETURN
  623. 13640  '----------------------- TEST PHONE NUMBER -----------------------------
  624. 13650  I3$=CHR$(SCREEN(CR,CC+L)):IF I3$<CHR$(48) OR I3$>CHR$(57) THEN 13655 ELSE RETURN
  625. 13655  IF I3$=CHR$(45) THEN RETURN
  626. 13660  ERRORN=1:LOCATE CR,CC+L:COLOR 15,0:PRINT I3$:COLOR 7,0:RETURN
  627. 13670  LOCATE 23,1:PRINT STRING$(75,32);:LOCATE 23,20:PRINT " Phone number must be NUMERIC. ";:LOCATE 9,7,1:COUNT=64:RETURN
  628. 13680  '----------------------- TEST NAME FIELDS ------------------------------
  629. 13684  I3$=CHR$(SCREEN(CR,CC+L))
  630. 13690  IF L<>0 THEN RETURN ELSE IF I3$=CHR$(45) OR I3$=CHR$(32) THEN GOTO 13695 ELSE RETURN
  631. 13695  ERRORN=1:LOCATE CR,CC+L:COLOR 15,0:PRINT I3$:COLOR 7,0:RETURN
  632. 13700  LOCATE 23,1:PRINT STRING$(75,32):LOCATE 23,20:PRINT " Name fields are required.";:LOCATE 3,13,1:COUNT=0:RETURN
  633. 13740  LOCATE 23,1:PRINT STRING$(75,32):LOCATE 23,20:PRINT " Name fields are required.";:LOCATE 3,41,1:COUNT=9:RETURN
  634. 15000  '-------------------------INKEY ROUTINE -------------------------------
  635. 15150  IP$=STRING$(IPC," "):CT=0:P1=0:PS=POS(0)
  636. 15155  IF OF=1 THEN LOCATE ,,1 ELSE LOCATE ,,0
  637. 15157  I$=INKEY$:IF I$="" THEN 15157 ELSE LOCATE ,,0
  638. 15161  IF I$=CR$ THEN 15200
  639. 15162  IF I$=CHR$(8) THEN LOCATE CSRLIN,POS(0)-1:PRINT" ";:LOCATE CSRLIN,POS(0)-1:CT=CT-1:IF CT<=0 THEN MID$(IP$,1)=SPACE$(IPC):BEEP:LOCATE CSRLIN,PS:CT=0:GOTO 15155:ELSE MID$(IP$,1)=LEFT$(IP$,CT)+" ":GOTO 15155
  640. 15164  IF LEN(I$)=2 THEN IF RIGHT$(I$,1)=CHR$(75) THEN LOCATE CSRLIN,POS(0)-1:PRINT" ";:LOCATE CSRLIN,POS(0)-1:CT=CT-1:IF CT<=0 THEN MID$(IP$,1)=SPACE$(IPC):BEEP:LOCATE CSRLIN,PS:CT=0:GOTO 15155:ELSE MID$(IP$,1)=LEFT$(IP$,CT)+" ":GOTO 15155
  641. 15165  IF LEN(I$)= 2 THEN 15155 ELSE IF I$=CHR$(46) THEN GOTO 15155 ELSE IF I$=CHR$(63) THEN 15155 ELSE IF ASC(I$) < 47 AND ASC(I$) > 122 THEN 15155
  642. 15166  IF I$=ESC$ THEN IP$=I$:RETURN
  643. 15170  IF PT=1 THEN PRINT I$;
  644. 15180  CT=CT+1:MID$(IP$,CT,1)=I$
  645. 15190  IF CT=IPC THEN RETURN ELSE GOTO 15155
  646. 15200  FOR L=IPC TO 1 STEP -1
  647. 15210  IF MID$(IP$,L,1)<>" " THEN P1=L:L=1
  648. 15220  NEXT L
  649. 15230  IP$=LEFT$(IP$,P1):RETURN
  650. 19999  '--------------------------OPENING LOGO ---------------------------------
  651. 20000  DIM C$(10,7)
  652. 20010  CLS
  653. 20020  M$(1,1)="CSRLINCSRLINCSRLINCSRLINCSRLIN CSRLINCSRLINCSRLINCSRLINCSRLIN"
  654. 20030  M$(1,2)=" CSRLINCSRLINCSRLINCSRLIN CSRLINCSRLINCSRLINCSRLIN "
  655. 20040  M$(1,3)=" CSRLINCSRLIN CSRLINCSRLINCSRLIN CSRLINCSRLIN "
  656. 20050  M$(1,4)=" CSRLINCSRLIN  CSRLIN  CSRLINCSRLIN "
  657. 20060  M$(1,5)=" CSRLINCSRLIN     CSRLINCSRLIN "
  658. 20070  M$(1,6)="CSRLINCSRLINCSRLIN     CSRLINCSRLINCSRLIN "
  659. 20080  M$(1,7)="CSRLINCSRLINCSRLIN     CSRLINCSRLINCSRLIN "
  660. 20090  C$(1,1)="   CSRLINCSRLINCSRLIN  "
  661. 20100  C$(1,2)="  CSRLINCSRLINCSRLINCSRLINCSRLIN"
  662. 20110  C$(1,3)=" CSRLINCSRLINCSRLINCSRLINCSRLINCSRLINCSRLIN"
  663. 20120  C$(1,4)="CSRLINCSRLINCSRLINCSRLIN CSRLINCSRLINCSRLINCSRLIN"
  664. 20130  C$(1,5)="CSRLINCSRLINCSRLIN   CSRLINCSRLINCSRLIN"
  665. 20140  C$(1,6)="CSRLINCSRLINCSRLINCSRLINCSRLINCSRLINCSRLINCSRLINCSRLIN"
  666. 20150  C$(1,7)="CSRLINCSRLINCSRLIN   CSRLINCSRLINCSRLIN"
  667. 20160  C$(2,1)="CSRLINCSRLINCSRLINCSRLINCSRLINCSRLINCSRLIN"
  668. 20170  C$(2,2)="  CSRLINCSRLINCSRLIN"
  669. 20180  C$(2,3)="  CSRLINCSRLINCSRLIN"
  670. 20190  C$(2,4)="  CSRLINCSRLINCSRLIN"
  671. 20200  C$(2,5)="  CSRLINCSRLINCSRLIN"
  672. 20210  C$(2,6)="  CSRLINCSRLINCSRLIN"
  673. 20220  C$(2,7)="CSRLINCSRLINCSRLINCSRLINCSRLINCSRLINCSRLIN"
  674. 20230  C$(3,1)="CSRLINCSRLINCSRLINCSRLIN"
  675. 20240  C$(3,2)=" CSRLINCSRLINCSRLIN"
  676. 20250  C$(3,3)=" CSRLINCSRLINCSRLIN"
  677. 20260  C$(3,4)=" CSRLINCSRLINCSRLIN"
  678. 20270  C$(3,5)=" CSRLINCSRLINCSRLIN"
  679. 20280  C$(3,6)=" CSRLINCSRLINCSRLIN     CSRLIN"
  680. 20290  C$(3,7)="CSRLINCSRLINCSRLINCSRLINCSRLINCSRLINCSRLINCSRLINCSRLINCSRLIN"
  681. 20300  C$(5,1)="CSRLINCSRLINCSRLINCSRLINCSRLINCSRLINCSRLINCSRLINCSRLINCSRLIN"
  682. 20310  C$(5,2)="CSRLINCSRLINCSRLIN    CSRLINCSRLINCSRLIN"
  683. 20320  C$(5,3)="CSRLINCSRLINCSRLIN"
  684. 20330  C$(5,4)="CSRLINCSRLINCSRLINCSRLINCSRLINCSRLINCSRLINCSRLINCSRLINCSRLIN"
  685. 20340  C$(5,5)="      CSRLINCSRLINCSRLINCSRLIN"
  686. 20350  C$(5,6)="CSRLINCSRLINCSRLIN   CSRLINCSRLINCSRLINCSRLIN"
  687. 20360  C$(5,7)="CSRLINCSRLINCSRLINCSRLINCSRLINCSRLINCSRLINCSRLINCSRLINCSRLIN"
  688. 20370  C$(6,1)="CSRLINCSRLINCSRLINCSRLINCSRLINCSRLINCSRLINCSRLINCSRLINCSRLIN"
  689. 20380  C$(6,2)="CSRLINCSRLINCSRLINCSRLINCSRLINCSRLINCSRLINCSRLINCSRLINCSRLIN"
  690. 20390  C$(6,3)="   CSRLINCSRLINCSRLINCSRLIN"
  691. 20400  C$(6,4)="   CSRLINCSRLINCSRLINCSRLIN"
  692. 20410  C$(6,5)="   CSRLINCSRLINCSRLINCSRLIN"
  693. 20420  C$(6,6)="   CSRLINCSRLINCSRLINCSRLIN"
  694. 20430  C$(6,7)="   CSRLINCSRLINCSRLINCSRLIN"
  695. 20440  C$(7,1)="CSRLINCSRLINCSRLINCSRLIN"
  696. 20450  C$(7,2)=" CSRLINCSRLINCSRLIN"
  697. 20460  C$(7,3)=" CSRLINCSRLINCSRLIN"
  698. 20470  C$(7,4)=" CSRLINCSRLINCSRLIN"
  699. 20480  C$(7,5)=" CSRLINCSRLINCSRLIN"
  700. 20490  C$(7,6)=" CSRLINCSRLINCSRLIN"
  701. 20500  C$(7,7)="CSRLINCSRLINCSRLINCSRLINCSRLIN"
  702. 20510  FOR Y= 1 TO 7
  703. 20520   LOCATE Y,12:PRINT M$(1,Y) TAB(25) C$(1,Y) TAB(36) C$(2,Y) TAB(45) C$(3,Y)
  704. 20530   LOCATE Y+8,22:PRINT C$(3,Y) TAB(34) C$(2,Y) TAB(44) C$(5,Y) TAB(56) C$(6,Y)
  705. 20540  NEXT Y
  706. 20550  COLOR 23,0
  707. 20560  FOR X= 17 TO 23
  708. 20570  LOCATE X,50:PRINT C$(7,X-16);
  709. 20580  NEXT
  710. 20590  COLOR 7,0
  711. 20600  LOCATE 24,1:PRINT "(C) COPYRIGHT William Dwinell and Mike Berry 1983";
  712. 20610  FOR WAITING=1 TO 3000:NEXT
  713. 20620  CLS
  714. 21140  FLEN=60:DPH=16:WDH=80:BDR=1
  715. 21160  Y=((WDH-FLEN)/2)-1:LOCATE BDR,Y:COLOR 15,0:PRINT CHR$(201);STRING$(FLEN+4,205);CHR$(187)
  716. 21180  FOR I=1 TO DPH:LOCATE I+BDR,Y:PRINT CHR$(186);:LOCATE I+BDR,(FLEN+5+Y):PRINT CHR$(186):NEXT
  717. 21200  LOCATE I+BDR,Y:PRINT CHR$(200);STRING$(FLEN+4,205);CHR$(188):COLOR 7,0
  718. 21220  LOCATE 3,37:COLOR 0,7:PRINT"  MAILIST1  ";:COLOR 7,0
  719. 21240  LOCATE 20,18:PRINT"(C) Copyright William Dwinell and Mike Berry 1983";
  720. 21242  LOCATE 4,36:PRINT" RELEASE 4.0 "
  721. 21244  LOCATE 6,12:PRINT "This program is released to PUBLIC DOMAIN with the provisions ";
  722. 21245  LOCATE 7,12:PRINT "that lines 20000 through 25000 of program remain unmodified.";
  723. 21246  LOCATE 11,12:PRINT "The authors would appreciate knowing of any problems or";
  724. 21247  LOCATE 12,12:PRINT "suggestions for improvements. Please notify by mail or";
  725. 21248  LOCATE 13,12:PRINT "a message on CompuServe, see next frame."
  726. 21249  LOCATE 9,12:PRINT "No portion of this program is to be sold."
  727. 21260  LOCATE 23,30:COLOR 16,7:PRINT" Press any key to continue ";:COLOR 7,0
  728. 21280  I$=INKEY$:IF I$="" GOTO 21280
  729. 21290  FOR NEWSCREEN = 6 TO 15:LOCATE NEWSCREEN,12:PRINT STRING$(61,32):NEXT
  730. 21300  LOCATE 6,12:PRINT "If you find this program is useful to you a contribution";
  731. 21310  LOCATE 7,12:PRINT "in the amount of $15 is suggested."
  732. 21320  LOCATE 9,12:PRINT "All contributers will be notified of enhancements or future";
  733. 21330  LOCATE 10,12:PRINT "releases of MAILIST1. Send contributions to:"
  734. 21340  LOCATE 12,20:PRINT "Mike Berry                 Bill Dwinell"
  735. 21350  LOCATE 13,20:PRINT "PO Box 18708               1144 Hallmark Drive"
  736. 21360  LOCATE 14,20:PRINT "Shreveport, La     or      Shreveport, La."
  737. 21370  LOCATE 15,20:PRINT "71138                      71118"
  738. 21380  LOCATE 16,20:PRINT "CIS 70235,1300             CIS 70055,1145"
  739. 24980  LOCATE 23,30:PRINT STRING$(45,32)
  740. 24990  LOCATE 23,30:COLOR 16,7:PRINT" Press any key to begin ";:COLOR 7,0
  741. 24999  I$=INKEY$:IF I$="" GOTO 24999 ELSE RETURN
  742. 25000  '(C) Copyright William Dwinell and Mike Berry 1983
  743.